home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol030 / filecab2.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  13.5 KB  |  410 lines
  1. 1010 P$="FILECAB.BAS":V$="82/04/16/1240"
  2. 1020 SCREEN 0,0,0:CLEAR
  3. 1030 KEY OFF: DEFINT A-Z:CLS
  4. 1040 OPEN "SCRN:" FOR OUTPUT AS #2
  5. 1050 DIM R$(65),AC(21),K(65),H$(21),RN$(21),Z$(21)
  6. 1060 COMMA$="NO" 'SEE INPUT ROUTINE
  7. 1070 H$(0)="REC #":DB$="":F$="BASENAME":ON ERROR GOTO 2320
  8. 1080 GOSUB 3840
  9. 1090 GOTO 2230
  10. 1100 F$=".HED":ON ERROR GOTO 1490:GOSUB 3840
  11. 1110 FOR I=1 TO NR:H$(I)=R$(I):NEXT I
  12. 1120 NH=NR:NR=0:MEM#=FRE(0)
  13. 1130 PRINT "AVAILABLE BYTES OF MEMORY ="FRE(0)
  14. 1140 AVGFLEN=20:B=INT(MEM#/(AVGFLEN*NH))-10
  15. 1150 PRINT "ASSUMING"AVGFLEN"CHARS/FIELD AND"NH"FIELDS"
  16. 1160 PRINT "MEMORY HAS ROOM FOR"B"RECORDS"
  17. 1170 DIM N$(B,NH),R(B)
  18. 1180 F$=".IND":ON ERROR GOTO 4530:GOSUB 3840
  19. 1190 GOTO 4510
  20. 1200 REM *** SORT ***
  21. 1210 FOR I=1 TO NR:R(I)=0:NEXT I
  22. 1220 FOR I=1 TO NR:FOR J=1 TO NR
  23. 1230 ON L GOTO 1240,1260
  24. 1240 IF N$(I,S)>=N$(J,S) THEN R(I)=R(I)+1
  25. 1250 GOTO 1270
  26. 1260 IF VAL(N$(I,S))>=VAL(N$(J,S)) THEN R(I)=R(I)+1
  27. 1270 NEXT J:NEXT I
  28. 1280 PRINT "SORT PHASE 1 FINISHED"
  29. 1290 FOR I=NR TO 1 STEP -1:FOR J=NR TO 1 STEP -1
  30. 1300 IF I<>J THEN IF R(I)=R(J) THEN R(J)=R(J)-1
  31. 1310 NEXT J:NEXT I
  32. 1320 PRINT "SORT PHASE 2 FINISHED"
  33. 1330 J=1
  34. 1340 IF R(J)=J THEN J=J+1:GOTO 1340
  35. 1350 IF J>=NR THEN 1400
  36. 1360 FOR I=1 TO NH
  37. 1370 Z$(I)=N$(R(J),I):N$(R(J),I)=N$(J,I):N$(J,I)=Z$(I):NEXT I
  38. 1380 Z=R(R(J)):R(R(J))=R(J):R(J)=Z
  39. 1390 GOTO 1340
  40. 1400 PRINT CHR$(7):PRINT "-Y- TO SAVE THE "DB$" FILE"
  41. 1410 PRINT "SORTED BY "H$(S);:INPUT L$
  42. 1420 IF L$="Y" THEN F$=".IND":GOSUB 3960
  43. 1430 GOTO 4510
  44. 1440 MF=1:GOSUB 3590
  45. 1450 INPUT "# OF SORT KEY FIELD";S$:S=VAL(S$)
  46. 1460 IF S<1 OR S>NH THEN 1450
  47. 1470 PRINT:INPUT "1 => SORT ALPHA; 2 => SORT NUMER ";L$:L=VAL(L$)
  48. 1480 PRINT:PRINT "SORT BEGINS":GOTO 1210
  49. 1490 RESUME 1500 'ERROR TARGET
  50. 1500 ON ERROR GOTO 0
  51. 1510 REM *** CREATE FIELDNAMEFILE ***
  52. 1520 NR=1
  53. 1530 CLS:PRINT "-RETURN- TO GO TO MAIN MENU":PRINT
  54. 1540 PRINT "FIELD NAME FOR FIELD"NR;:INPUT R$(NR)
  55. 1550 IF R$(NR)="" OR NR>20 THEN 1580
  56. 1560 NR=NR+1
  57. 1570 GOTO 1540
  58. 1580 NR=NR-1
  59. 1590 GOSUB 3960:GOTO 1110
  60. 1600 REM ***ENTER RECORDS***
  61. 1610 CLS
  62. 1620 PRINT "THERE ARE "NR" RECORDS IN THE "DB$" FILE"
  63. 1630 NR=NR+1
  64. 1640 PRINT "YOU ARE ENTERING RECORD"NR:PRINT
  65. 1650 FOR I=1 TO NH:PRINT H$(I)":";:GOSUB 4420:N$(NR,I)=I$:NEXT I:PRINT
  66. 1660 INPUT "-Y- TO ENTER ANOTHER RECORD";L$
  67. 1670 IF L$="Y" THEN 1620:F$=".IND"
  68. 1680 GOSUB 3960
  69. 1690 GOTO 4510
  70. 1700 REM ***SEARCH/CHANGE***
  71. 1710 L=0
  72. 1720 CLS:PRINT "SEARCH ANY OF THE FOLLOWING FIELDS:":PRINT
  73. 1730 GOSUB 3590
  74. 1740 PRINT:PRINT "OR":PRINT:PRINT I" MAKE CHANGES":PRINT
  75. 1750 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
  76. 1760 IF S<0 OR S>NH+1 THEN 1750
  77. 1770 IF S=NH+1 THEN 1940
  78. 1780 CLS:PRINT "ENTER THE"H$(S):PRINT "TO BE FOUND":INPUT Q$
  79. 1790 CLS:FOR J=1 TO NR:N$(J,0)=STR$(J)
  80. 1800 IF LEFT$(N$(J,S),LEN(Q$))=Q$ THEN GOSUB 2050
  81. 1810 IF L+NH>20 THEN GOSUB 1890
  82. 1815 NEXT J
  83. 1820 PRINT "SEARCH FINISHED":PRINT
  84. 1830 PRINT "1 => DO MORE SEARCHES"
  85. 1840 PRINT "2 => MAKE CHANGES"
  86. 1850 PRINT "3 => RETURN TO MAIN MENU"
  87. 1860 INPUT S$:S=VAL(S$)
  88. 1870 IF S<1 OR S>3 THEN 1860
  89. 1880 ON S GOTO 1720,1940,4510
  90. 1890 IF PF <> 0 THEN 1930
  91. 1900 PRINT "-RETURN- TO CONTINUE; -ESC- TO GO TO MAIN MENU";
  92. 1910 L$=INKEY$:IF L$="" THEN 1910
  93. 1920 IF ASC(L$)=27 THEN 4510:IF ASC(L$)<>13 THEN 1910
  94. 1930 L=0:CLS:RETURN
  95. 1940 REM ***CHANGE DATA***
  96. 1950 INPUT "REC # TO BE CHANGED";J$:J=VAL(J$)
  97. 1960 CLS:GOSUB 2050
  98. 1970 PRINT "FIELD NUMBER TO BE CHANGED ("I"FOR NO CHANGE)"
  99. 1980 INPUT S$:S=VAL(S$)
  100. 1990 IF S<1 THEN 1980 ELSE IF S>NH THEN 2020
  101. 2000 PRINT:PRINT "FROM"H$(S)": "N$(J,S):PRINT:PRINT "TO"H$(S)": ";
  102. 2010 INPUT N$(J,S):CLS:GOSUB 2050
  103. 2020 PRINT:INPUT "-Y- TO CHANGE ANOTHER RECORD";L$
  104. 2030 IF L$="Y" THEN 1940
  105. 2040 F$=".IND":GOSUB 3960:GOTO 4510
  106. 2050 REM ***PRINT A RECORD***
  107. 2060 ON PF GOSUB 4850,4880,4920
  108. 2070 PRINT #2," "H$(0)": ";J
  109. 2080 FOR I=1 TO NH:PRINT #2,I" "H$(I)": "N$(J,I):NEXT I:PRINT #2,
  110. 2090 L=L+NH+2
  111. 2100 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
  112. 2110 RETURN
  113. 2120 REM ***DELETE RECORDS***
  114. 2130 CLS
  115. 2140 PRINT "REC # TO BE DELETED ("NR+1"TO ABORT DELETION)";
  116. 2150 INPUT DR$:DR=VAL(DR$)
  117. 2160 IF DR<1 THEN 2140 ELSE IF DR>NR THEN NR=NR+1:GOTO 2200
  118. 2170 FOR J=DR TO NR-1:FOR I=1 TO NH
  119. 2180 N$(J,I)=N$(J+1,I):NEXT I:NEXT J
  120. 2190 PRINT:PRINT "RECORD NUMBER "DR" DELETED!":PRINT
  121. 2200 INPUT "-Y- TO DELETE MORE";L$
  122. 2210 IF L$="Y" THEN 2140
  123. 2220 NR=NR-1:F$=".IND":GOSUB 3960:GOTO 4510
  124. 2230 REM *** BASENAMEFILE ROUTINES ***
  125. 2240 CLS:PRINT "SELECT FROM:":PRINT
  126. 2250 FOR J=1 TO NR:PRINT J" "R$(J):NEXT J:PRINT
  127. 2260 PRINT J" CREATE A NEW DATA BASE"
  128. 2270 IF J>1 THEN PRINT J+1" DELETE A DATA BASE":PRINT
  129. 2280 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
  130. 2290 IF S=(J+1) THEN 2370
  131. 2300 IF S<1 OR S>J THEN PRINT CHR$(7);:GOSUB 4990:GOTO 2280
  132. 2310 DB$=R$(S):IF S<>J THEN 1100
  133. 2315 PRINT:GOTO 2340
  134. 2320 RESUME 2330 'ERROR TARGET
  135. 2330 ON ERROR GOTO 0
  136. 2340 IF J=0 THEN J=1
  137. 2345 INPUT "NAME FOR NEW DATA BASE FILE :";R$(J)
  138. 2350 NR=J:GOSUB 3960
  139. 2360 DB$=R$(J-1):GOTO 1100
  140. 2370 REM  *** DELETE A DATA BASE ***
  141. 2380 PRINT:INPUT "DELETE WHICH DATABASE: ";S$:S=VAL(S$)
  142. 2390 IF S<1 OR S>J-1 THEN PRINT CHR$(7);:GOSUB 4990:GOTO 2380
  143. 2400 CLS:LOCATE 9,1
  144. 2410 PRINT "READY TO DELETE "CHR$(34);R$(S);CHR$(34);".":PRINT
  145. 2420 PRINT "ONCE DELETED, THIS DATA CANNOT BE RECOVERED."
  146. 2430 PRINT "ARE YOU SURE YOU WANT TO DELETE IT (Y/N) ";:INPUT S$
  147. 2440 IF S$<>"Y" THEN 2230
  148. 2450 CLS:LOCATE 12,11:COLOR 0,7:PRINT "  DELETING DATABASE  ":COLOR 7,0
  149. 2460 ON ERROR GOTO 2500
  150. 2470 DB$=R$(S):DB$=R$(S):F$=".RPN":GOSUB 3840:KILL DB$+F$
  151. 2480 FOR I=1 TO NR:KILL DB$+R$(I)+".RPT":NEXT I
  152. 2490 GOTO 2520
  153. 2500 RESUME 2510 'TARGET OF ERROR
  154. 2510 ON ERROR GOTO 0
  155. 2520 ON ERROR GOTO 4960
  156. 2530 KILL DB$+".RPN":KILL DB$+".IND":KILL DB$+".HED"
  157. 2540 ON ERROR GOTO 0
  158. 2550 DB$=""
  159. 2560 F$="BASENAME":GOSUB 3840
  160. 2570 IF NR=1 THEN KILL "BASENAME":GOTO 1010
  161. 2580 FOR I=S TO NR-1:R$(I)=R$(I+1):NEXT I
  162. 2590 NR=NR-1:GOSUB 3960
  163. 2600 GOTO 2230
  164. 2610 REM ***REPORT***
  165. 2620 T9=0
  166. 2630 CLS:E=0
  167. 2640 FOR I=0 TO 3*NH+2:K(I)=0:NEXT I
  168. 2650 FOR I=0 TO NH:AC(I)=0:NEXT I:HC=0:GT=0
  169. 2660 ON E GOTO 2860
  170. 2670 GOTO 3650
  171. 2680 PRINT:INPUT "HOW MANY FIELD NAMES";RH$
  172. 2690 RH= VAL(RH$):IF RH<1 OR RH>NH+1 THEN 2680
  173. 2700 IF E=0 THEN RN$(NN)="PRESENT"
  174. 2710 FOR I=1 TO RH*3 STEP 3
  175. 2720 PRINT "ENTER # OF FIELD NAME TO GO IN"
  176. 2730 PRINT "POSITION #"(I+2)/3" ";:INPUT "";K$:K(I)=VAL(K$)
  177. 2740 IF K(I)<0 OR K(I)>NH THEN  2720
  178. 2750 PRINT "ENTER STARTING COLUMN FOR"H$(K(I))" ";:INPUT K$:K(I+1)=VAL(K$)
  179. 2760 IF K(I+1)<0 OR K(I+1)>255 THEN 2750
  180. 2770 PRINT "CALCULATE COLUMN TOTAL ON"H$(K(I))" (Y/N)";:INPUT L$
  181. 2780 IF L$="Y" THEN K(I+2)=1:K(0)=1
  182. 2790 NEXT I
  183. 2800 IF K(0)<>1 THEN 2860
  184. 2810 INPUT "ENTER STARTING COLUMN FOR TOTAL: ";A$
  185. 2820 IF LEN(A$)=0 THEN K(0)=0:T9=1:GOTO 2860
  186. 2830 K(I+1)=VAL(A$)
  187. 2840 IF K(I+1)<0 OR K(I+1)>131 THEN PRINT CHR$(7):RWLC=CSRLIN-2
  188. 2850 IF K(I+1)<0 OR K(I+1)>131 THEN LOCATE RWLC,1:GOTO 2810
  189. 2860 PRINT
  190. 2870 INPUT "SELECT RECORDS BY WHICH FIELD # ";S$:S=VAL(S$)
  191. 2880 IF LEN(S$)=0 THEN Q$="@":GOTO 2950
  192. 2890 PRINT:INPUT "'AND' 2ND HEADER (Y/N)";L$
  193. 2900 IF L$<>"Y" THEN X$="@":GOTO 2920
  194. 2910 PRINT:INPUT "ENTER # OF 'AND' HEADER ";X$:X=VAL(X$)
  195. 2920 PRINT:PRINT "@ WILL SELECT ALL RECORDS."
  196. 2930 PRINT:PRINT "SELECT RECORDS FOR"H$(S)"= ";:INPUT Q$:PRINT
  197. 2940 IF L$="Y" THEN PRINT "AND "H$(X)"= ";:INPUT X$
  198. 2950 FOR I=1 TO RH+1:REM IF K(3*I-1)>35 THEN PF = 2
  199. 2960 NEXT I
  200. 2970 ON PF GOSUB 4850,4880,4920:GOSUB 3310
  201. 2980 FOR J=1 TO NR
  202. 2990 N$(J,0)=STR$(J)
  203. 3000 IF Q$="@" THEN 3040
  204. 3010 IF LEFT$(N$(J,S),LEN(Q$))<>Q$ THEN 3050
  205. 3020 IF X$="@" THEN 3040
  206. 3030 IF LEFT$(N$(J,X),LEN(X$))<>X$ THEN 3050
  207. 3040 GOSUB 3160
  208. 3050 IF PF<1 THEN IF L>18 THEN GOSUB 1890:GOSUB 3310
  209. 3060 IF L=0 THEN GOSUB 3310
  210. 3070 NEXT J
  211. 3080 ON T9 GOSUB 3240
  212. 3090 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
  213. 3100 ON E GOTO 3130
  214. 3110 PRINT:PRINT "-Y- TO SAVE THE FORMAT FOR THIS REPORT":INPUT L$
  215. 3120 IF L$="Y" THEN E=1:GOSUB  3410
  216. 3130 PRINT:PRINT "-Y- FOR MORE REPORTS WITH THE "RN$(NN)" FORMAT":INPUT L$
  217. 3140 IF L$="Y" THEN GOSUB 3590:E=1:GOTO 2650
  218. 3150 GOTO 4510
  219. 3160 FOR I=1 TO RH
  220. 3170 PRINT #2,TAB(K(3*I-1)) N$(J,K(3*I-2));:ON K(3*I) GOSUB 3210:NEXT I
  221. 3180 IF K(0)=1 THEN IF HC<>0 THEN PRINT #2,TAB(K(3*I-1)) HC;:GT=GT+HC:HC=0
  222. 3190 L=L+1
  223. 3200 PRINT #2,:RETURN
  224. 3210 N=3*I-2
  225. 3220 V=VAL(N$(J,K(N))):AC(I)=AC(I)+V:HC=HC+V
  226. 3230 RETURN
  227. 3240 FOR I=1 TO 39+((PF>1)*39):PRINT #2,"-";:NEXT I:PRINT #2,
  228. 3250 FOR I=1 TO RH
  229. 3260 IF AC(I)=0 THEN 3280
  230. 3270 PRINT #2,TAB(K(3*I-1)) AC(I);
  231. 3280 NEXT I
  232. 3290 IF GT<>0 THEN PRINT #2,TAB(K(3*I-1)) GT;
  233. 3300 PRINT #2,:RETURN
  234. 3310 CLS
  235. 3320 IF PF=>1 THEN PRINT #2,CHR$(27)+CHR$(12) 'TOP OF FORM
  236. 3330 PRINT #2,RN$(NN)"REPORT FOR"H$(S)":"Q$;
  237. 3340 IF X$="@" THEN 3360
  238. 3350 PRINT #2," AND"H$(X)":"X$:GOTO 3370
  239. 3360 PRINT #2,"  "
  240. 3370 FOR I=1 TO RH:PRINT #2,TAB(K(3*I-1)) H$(K(3*I-2));:NEXT I
  241. 3380 IF K(0)=1 THEN PRINT #2,TAB(K(3*I-1)) "TOTAL";
  242. 3390 PRINT #2,:PRINT #2,
  243. 3400 L=4:RETURN
  244. 3410 REM *** SET-UP TO SAVE RPTFMTFILE ***
  245. 3420 NS=NR
  246. 3430 PRINT:INPUT "TYPE THE REPORT FORMAT NAME ";RN$(NN)
  247. 3440 F$=RN$(NN)+".RPT"
  248. 3450 PRINT F$ "*****TEST***"
  249. 3460 NR=3*RH+2
  250. 3470 FOR I=1 TO NR:R$(I)=STR$(K(I)):NEXT I
  251. 3480 R$(I-2)=STR$(K(0))
  252. 3490 GOSUB 3960:GOSUB 4090
  253. 3500 RETURN
  254. 3510 REM *** SET-UP TO READ RPTFMTFILE ***
  255. 3520 F$=RN$(NN)+".RPT"
  256. 3530 PRINT F$ "******TEST*****"
  257. 3540 GOSUB 3840
  258. 3550 RH=(NR-2)/3:FOR I=1 TO NR:K(I)=VAL(R$(I)):NEXT I
  259. 3560 K(0)=VAL(R$(I-2))
  260. 3570 NR=NS
  261. 3580 GOSUB 3590:PRINT:GOTO 2870
  262. 3590 REM *** SUB MENU ***
  263. 3600 PRINT "SELECT FROM:":PRINT
  264. 3610 IF MF=0 THEN PRINT "0 "H$(0)
  265. 3620 FOR I=1 TO NH:PRINT I" "H$(I):NEXT I:PRINT
  266. 3630 MF=0
  267. 3640 RETURN
  268. 3650 REM *** READ REPORTNAMEFILE & SELECT REPORT ***
  269. 3660 NN=0:FOR I=0 TO 21:RN$(I)="":NEXT I:NS=NR
  270. 3670 F$=".RPN"
  271. 3680 ON ERROR GOTO 3780
  272. 3690 GOSUB 3840
  273. 3700 FOR I=1 TO NR:RN$(I)=R$(I):NEXT I
  274. 3710 CLS:PRINT "SELECT FROM:":PRINT
  275. 3720 FOR I=1 TO NR:PRINT I" "R$(I):NEXT I:PRINT
  276. 3730 PRINT I" CREATE A NEW REPORT FORMAT":PRINT
  277. 3740 INPUT "WHICH ";S$:S=VAL(S$):IF S<1 OR S>I THEN 3740
  278. 3750 NN=S
  279. 3760 IF S<>I THEN RN$(S)=R$(S):E=1:NR=NS:GOTO 3510
  280. 3770 GOTO 3830
  281. 3780 RESUME 3790 'TARGET OF ERROR
  282. 3790 ON ERROR GOTO 0
  283. 3800 CLS:PRINT "NO REPORT FORMATS ON DISK":PRINT
  284. 3810 NN=1
  285. 3820 INPUT "CREATE ONE (Y/N) ?";L$:IF L$<>"Y" THEN 4510
  286. 3830 GOSUB 3590:NR=NS:GOTO 2680
  287. 3840 REM *** READ FILES ***
  288. 3850 IF F$<>".IND" THEN FF=1
  289. 3860 OPEN DB$+F$ FOR INPUT AS #1
  290. 3870 ON ERROR GOTO 0
  291. 3880 INPUT #1,NR
  292. 3890 FOR J=1 TO NR
  293. 3900 ON FF GOTO 3930
  294. 3910 FOR I=1 TO NH:INPUT #1,I$:N$(J,I)=I$:NEXT I
  295. 3920 GOTO 3940
  296. 3930 INPUT #1,R$(J)
  297. 3940 NEXT J
  298. 3950 CLOSE #1:FF=0:RETURN
  299. 3960 REM *** SAVE FILES ***
  300. 3970 IF F$<>".IND" THEN FF=1
  301. 3980 OPEN DB$+F$ FOR OUTPUT AS #1
  302. 3990 PRINT #1,NR
  303. 4000 FOR J=1 TO NR
  304. 4010 ON FF GOTO 4040
  305. 4020 FOR I=1 TO NH:PRINT #1,N$(J,I):NEXT I
  306. 4030 GOTO 4050
  307. 4040 PRINT #1,R$(J)
  308. 4050 NEXT J
  309. 4060 CLOSE #1
  310. 4070 FF=0
  311. 4080 RETURN
  312. 4090 REM *** SAVE REPORTNAMEFILE ***
  313. 4100 NR=NN
  314. 4110 F$=".RPN"
  315. 4120 FOR I=1 TO NR:R$(I)=RN$(I):NEXT I
  316. 4130 GOSUB 3960
  317. 4140 NR=NS:RETURN
  318. 4150 REM  *** LIST ***
  319. 4160 L=0
  320. 4170 CLS
  321. 4180 REM IF PF=>1 THEN LPRINT CHR$(12)
  322. 4190 FOR J=1 TO NR
  323. 4200 ON PF GOSUB 4850,4880,4920
  324. 4210 PRINT #2,"  "H$(0)": ";J:L=L+1
  325. 4220 FOR I=1 TO NH
  326. 4230 PRINT #2,I" "H$(I)": "N$(J,I)
  327. 4240 L=L+1
  328. 4250 NEXT I
  329. 4260 PRINT #2,:L=L+1
  330. 4270 IF L+NH>20 THEN 4320
  331. 4280 NEXT J
  332. 4290 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
  333. 4300 INPUT "-RETURN- FOR MENU";L$
  334. 4310 GOTO 4510
  335. 4320 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
  336. 4330 PRINT "-RETURN- TO CONTINUE; -ESC- FOR MENU";
  337. 4340 L$=INKEY$:IF L$="" THEN 4340
  338. 4350 IF ASC(L$)=27 THEN 4510
  339. 4360 IF ASC(L$)=13 THEN 4380
  340. 4370 GOTO 4340
  341. 4380 CLS:L=0
  342. 4390 ON PF GOSUB 4850,4880,4920
  343. 4400 GOTO 4280
  344. 4410 STOP
  345. 4420 REM   ***  INPUT ROUTINES  ***
  346. 4430 I$ = ""
  347. 4440 IF COMMA$="NO" THEN INPUT I$:RETURN
  348. 4450 A$=INKEY$:IF A$="" THEN 4450
  349. 4460 IF A$=CHR$(3) THEN STOP
  350. 4470 PRINT A$;
  351. 4480 IF A$=CHR$(13) THEN RETURN
  352. 4490 I$=I$+A$
  353. 4500 GOTO 4450
  354. 4510 REM *** MAIN MENU ***
  355. 4520 GOTO 4550
  356. 4530 RESUME 4540 '  TARGET OF ERROR
  357. 4540 ON ERROR GOTO 0
  358. 4550 CLS
  359. 4560 PRINT "******* DATA BASE MANAGEMENT I *******"
  360. 4570 PRINT:PRINT "        IBM PERSONAL COMPUTER"
  361. 4580 PRINT
  362. 4590 PRINT "CURRENT DATA BASE: "DB$" NOW HAS"NR"RECORDS:PRINT
  363. 4600 PRINT "ASSUMING"AVGFLEN"CHARS/FIELD, ROOM FOR"B - NR"MORE":PRINT
  364. 4610 IF PF >=1 THEN PRINT "PRINTER ";:COLOR 23:PRINT "ON":COLOR 7:GOTO 4630
  365. 4620 PRINT "PRINTER OFF"
  366. 4630 PRINT
  367. 4640 PRINT "1  SELECT DATA BASE"
  368. 4650 PRINT "2  SEARCH AND/OR CHANGE DATA"
  369. 4660 PRINT "3  ENTER RECORDS"
  370. 4670 PRINT "4  DELETE RECORDS"
  371. 4680 PRINT "5  REPORT"
  372. 4690 PRINT "6  SORT (TAKES ABOUT"INT(.0008*NR^2+.03*NR)"MINUTES)"
  373. 4700 PRINT "7  TURN ON PRINTER"
  374. 4710 PRINT "8  TURN OFF PRINTER"
  375. 4720 PRINT "9  LIST ALL RECORDS"
  376. 4730 PRINT "10 QUIT"
  377. 4740 PRINT
  378. 4750 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
  379. 4760 IF S<1 OR S>10 THEN 4510
  380. 4770 ON S GOTO 4845,1700,1600,2120,2610,1440,4780,4830,4150,4840
  381. 4780 CLS:PRINT "PRINTER OPTIONS:"
  382. 4790 PRINT "1 => 40 COLUMNS; 2 => 80 COLUMNS; 3 => 132 COLUMNS"
  383. 4800 PRINT:INPUT "WHICH ";PF$:PF=VAL(PF$)
  384. 4810 IF PF<1 OR PF>3 THEN 4800
  385. 4820 GOTO 4510
  386. 4830 PF=0:CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2:GOTO 4510
  387. 4840 END
  388. 4845 CLOSE
  389. 4846 RUN
  390. 4850 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
  391. 4860 PRINT #2,CHR$(18)
  392. 4870 PRINT "K":RETURN
  393. 4880 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
  394. 4890 PRINT #2,CHR$(18)
  395. 4900 PRINT "K80N"
  396. 4910 RETURN
  397. 4920 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
  398. 4930 PRINT #2,CHR$(15)
  399. 4940 PRINT "K132N"
  400. 4945 END
  401. 4946 RUN
  402. 4950 RETURN
  403. 4960 REM CLEAR ERROR IF .RPN FILE DOSENT EXIST
  404. 4970 RESUME NEXT
  405. 4980 REM SUBROUTINE TO ERASE A LINE
  406. 4990 RWLC=CSRLIN-1:LOCATE RWLC,1:PRINT STRING$(39," ");:LOCATE RWLC,1
  407. 5000 RETURN
  408. NEXT
  409. 4980 REM SUBROUTINE TO ERASE A LINE
  410. 4990 RWLC=CSRLIN-1:LOCATE RWLC,1:PRINT STRING$(3